﻿namespace FML

#light

module StateT =
 module Option = 
 
  open StateM
  open OptionM
  
  
  type StateOptionT<'a, 'state> = StateOptionT of ('state ->  ('a * 'state) option)

  let run (StateOptionT f) s = f s

  type IStateOptionTrans = interface
    abstract Bind : StateOptionT<'a, 'state> * ('a -> StateOptionT<'b, 'state>) -> StateOptionT<'b, 'state>
    abstract Let :  'a * ('a ->  StateOptionT<'b, 'state>) -> StateOptionT<'b, 'state>
    abstract Return : 'a -> StateOptionT<'a, 'state>
    abstract Delay : f:(unit -> StateOptionT<'a, 'state>) -> StateOptionT<'a, 'state>
    abstract Lift : a:'a option -> StateOptionT<'a, 'state>  
  end
  
  type StateOptionBuilder(optionM : IOptionMonad) = class end
    with interface IStateOptionTrans with
                member s.Bind(m, f) =  StateOptionT ( fun state -> optionM  {   let! a = run m state
                                                                                let (r, state') = a
                                                                                let! a' = run (f r) state'
                                                                                return a'
                                                                            })
                member s.Let(a, f) =   f a
                member s.Return a =  StateOptionT (fun state -> optionM.Return( (a, state) ))
                member s.Delay f = f()
                member s.Lift(m) = StateOptionT (fun state -> optionM { let! a = m
                                                                        return (a,state)
                                                                      })


  let stateOptionT = new StateOptionBuilder(optionM) :>  IStateOptionTrans
 
  let lift m = stateOptionT.Lift(m)

  
  let get = StateOptionT (fun state -> optionM.Return((state, state)))
  let set newState = StateOptionT (fun _ -> optionM.Return( ( (), newState) ))
  let modify f = StateOptionT (fun s -> optionM.Return( ((), f s) ))
   

 module List = 
 
  open StateM
  open ListM
  
  
  type StateListT<'a, 'state> = StateListT of ('state ->  ('a * 'state) list)

  let run (StateListT f) s = f s

  type IStateListTrans = interface
    abstract Bind : StateListT<'a, 'state> * ('a -> StateListT<'b, 'state>) -> StateListT<'b, 'state>
    abstract Let :  'a * ('a ->  StateListT<'b, 'state>) -> StateListT<'b, 'state>
    abstract Return : 'a -> StateListT<'a, 'state>
    abstract Delay : f:(unit -> StateListT<'a, 'state>) -> StateListT<'a, 'state>
    abstract Lift : a:'a list -> StateListT<'a, 'state>  
  end
  
  type StateListBuilder(listM : IListMonad) = class end
    with interface IStateListTrans with
                member s.Bind(m, f) =  StateListT ( fun state -> listM {    let! a = run m state
                                                                            let (r, state') = a
                                                                            let! a' = run (f r) state'
                                                                            return a'
                                                                        })
                member s.Let(a, f) =   f a
                member s.Return a =  StateListT (fun state -> listM.Return( (a, state) ))
                member s.Delay f = f()
                member s.Lift(m) = StateListT (fun state ->  listM { let! a = m
                                                                     return (a,state)
                                                                   })


  let stateListT = new StateListBuilder(listM) :>  IStateListTrans
 
  let lift m = stateListT.Lift(m)

  
  let get = StateListT (fun state -> listM.Return((state, state)))
  let set newState = StateListT (fun _ -> listM.Return( ( (), newState) ))
  let modify f = StateListT (fun s -> listM.Return( ((), f s) ))


 module Error = 
 
  open StateM
  open ErrorM
  
  
  type StateErrorT<'l, 'a, 'state> = StateErrorT of ('state -> Either<'l, ('a * 'state)> )

  let run (StateErrorT f) s = f s

  type IStateErrorTrans = interface
    abstract Bind : StateErrorT<'l, 'a, 'state> * ('a -> StateErrorT<'l, 'b, 'state>) -> StateErrorT<'l, 'b, 'state>
    abstract Let :  'a * ('a ->  StateErrorT<'l, 'b, 'state>) -> StateErrorT<'l, 'b, 'state>
    abstract Return : 'a -> StateErrorT<'l, 'a, 'state>
    abstract Delay : f:(unit -> StateErrorT<'l, 'a, 'state>) -> StateErrorT<'l, 'a, 'state>
    abstract Lift : a:Either<'l, 'a> -> StateErrorT<'l, 'a, 'state>  
  end
  
  type StateErrorBuilder(errorM : IErrorMonad) = class end
    with interface IStateErrorTrans with
                member s.Bind(m, f) =  StateErrorT ( fun state -> errorM {  let! a = run m state
                                                                            let (r, state') = a
                                                                            let! a' = run (f r) state'
                                                                            return a'
                                                                         })
                member s.Let(a, f) =   f a
                member s.Return a =  StateErrorT (fun state -> errorM.Return( (a, state) ))
                member s.Delay f = f()
                member s.Lift(m) = StateErrorT (fun state ->  errorM { let! a = m
                                                                       return (a,state)
                                                                     })


  let stateErrorT = new StateErrorBuilder(errorM) :>  IStateErrorTrans
 
  let lift m = stateErrorT.Lift(m)

  let get = StateErrorT (fun state -> errorM.Return((state, state)))
  let set newState = StateErrorT (fun _ -> errorM.Return( ( (), newState) ))
  let modify f = StateErrorT (fun s -> errorM.Return( ((), f s) ))

 module Reader = 
 
  open StateM
  open ReaderM
  
  
  type StateReaderT<'env, 'a, 'state> = StateReaderT of ('state -> Reader<('a * 'state), 'env> )

  let run (StateReaderT f) s = f s

  type IStateReaderTrans = interface
    abstract Bind : StateReaderT<'env, 'a, 'state> * ('a -> StateReaderT<'env, 'b, 'state>) -> StateReaderT<'env, 'b, 'state>
    abstract Let :  'a * ('a ->  StateReaderT<'env, 'b, 'state>) -> StateReaderT<'env, 'b, 'state>
    abstract Return : 'a -> StateReaderT<'env, 'a, 'state>
    abstract Delay : f:(unit -> StateReaderT<'env, 'a, 'state>) -> StateReaderT<'env, 'a, 'state>
    abstract Lift : a: Reader<'a, 'env> -> StateReaderT<'env, 'a, 'state>  
  end
  
  type StateReaderBuilder(readerM : IReaderMonad) = class end
    with interface IStateReaderTrans with
                member s.Bind(m, f) =  StateReaderT ( fun state -> readerM  {   let! a = run m state
                                                                                let (r, state') = a
                                                                                let! a' = run (f r) state'
                                                                                return a'
                                                                            })
                member s.Let(a, f) =   f a
                member s.Return a =  StateReaderT (fun state -> readerM.Return( (a, state) ))
                member s.Delay f = f()
                member s.Lift(m) = StateReaderT (fun state ->  readerM { let! a = m
                                                                         return (a, state)
                                                                       })

  let stateReaderT = new StateReaderBuilder(readerM) :>  IStateReaderTrans
 
  let lift m = stateReaderT.Lift(m)

  
 module Writer = 

  open StateM
  open WriterM
  open Monoid

  type StateWriterT<'s, 'a, 'state> = StateWriterT of ('state -> Writer<('a * 'state), 's> )

  let run (StateWriterT f) s = f s

  type IStateWriterTrans<'s> = interface
    abstract Bind : StateWriterT<'s, 'a, 'state> * ('a -> StateWriterT<'s, 'b, 'state>) -> StateWriterT<'s, 'b, 'state>
    abstract Let :  'a * ('a ->  StateWriterT<'s, 'b, 'state>) -> StateWriterT<'s, 'b, 'state>
    abstract Return : 'a -> StateWriterT<'s, 'a, 'state>
    abstract Delay : f:(unit -> StateWriterT<'s, 'a, 'state>) -> StateWriterT<'s, 'a, 'state>
    abstract Lift : a: Writer<'a, 's> -> StateWriterT<'s, 'a, 'state>  
  end

  
  type StateWriterBuilder<'s>(writerM : IWriterMonad<'s>) = class end
    with interface IStateWriterTrans<'s> with
                member s.Bind(m, f) =  StateWriterT ( fun state -> writerM  {   let! a = run m state
                                                                                let (r, state') = a
                                                                                let! a' = run (f r) state'
                                                                                return a'
                                                                            })
                member s.Let(a, f) =   f a
                member s.Return a =  StateWriterT (fun state -> writerM.Return( (a, state) ))
                member s.Delay f = f()
                member s.Lift(m) = StateWriterT (fun state ->  writerM { let! a = m
                                                                         return (a, state)
                                                                       })


  let stateWriterT (monoid : Monoid<'s>) = new StateWriterBuilder<'s>(writerM monoid) :>  IStateWriterTrans<'s>
  
  let lift (swT:IStateWriterTrans<'s>) m = swT.Lift(m)
  
